home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Nibble Magazine
/
nib19b.dsk
/
HIDDEN LINES.bas
< prev
next >
Wrap
BASIC Source File
|
2023-02-26
|
6KB
|
162 lines
10 REM **********************
20 REM * HIDDEN LINES *
30 REM * BY R.B. GOLDSTEIN *
40 REM * COPYRIGHT (C) 1984 *
50 REM * BY MICROSPARC, INC *
60 REM * LINCOLN, MA. 01773 *
70 REM **********************
80 D$ = CHR$(4): ONERR GOTO 1600
90 MX = 1E6:MN = -MX:U = 1:Z = 0:EPS = 1E -3:T$ = "THINKING"
100 DIM U(150),V(150),W(150),E%(150,4),F%(50,1),FP%(150)
110 DIM EU(50,1),EV(50,1),EW(50,1),S(18,1),T(18,1),V%(50),X(150),Y(150),Z(150)
120 REM * READ FILE *
130 TEXT : HOME : VTAB 20: PRINT "** COPYRIGHT 1984 BY MICROSPARC, INC. **": VTAB 2: INPUT "FILE NAME:";F$
140 PRINT D$"VERIFY"F$: PRINT D$"OPEN"F$: PRINT D$"READ"F$
150 INPUT NP,NE,NF
160 FOR I = U TO NP: INPUT X(I),Y(I),Z(I): NEXT
170 F%(U,U) = U: FOR I = U TO NF: INPUT N:F%(I,Z) = N:F%(I +U,U) = F%(I,U) +N:I1 = F%(I,U):I2 = I1 +N -U
180 FOR J = I1 TO I2: INPUT FP%(J): NEXT : NEXT
190 FOR I = U TO NE: INPUT E%(I,1),E%(I,2),E%(I,3),E%(I,4): NEXT
200 PRINT D$"CLOSE"F$
210 REM * VIEWPOINT *
220 PRINT "LINE OF SIGHT:": INPUT "XE,YE,ZE=";XE,YE,ZE
230 Q1 = XE *XE +YE *YE:Q2 = SQR(Q1):Q3 = SQR(Q1 +ZE *ZE):Q4 = 1/(Q2 *Q3)
240 INPUT "K=";K
250 UL = MX:UH = MN:VL = MX:VH = MN
260 REM *COMPUTE TRANSFORMATION *
270 FOR I = U TO NP
280 A = X(I):B = Y(I):C = Z(I)
290 W(I) = -(XE *A +YE *B +ZE *C)
300 T = (U -K)/(U +W(I)/(Q3 *Q3))
310 U(I) = T *(XE *B -YE *A)/Q2
320 V(I) = T *(Q1 *C -(A *XE +B *YE) *ZE) *Q4
330 W(I) = T *W(I)
340 IF U(I) <UL THEN UL = U(I)
350 IF U(I) >UH THEN UH = U(I)
360 IF V(I) <VL THEN VL = V(I)
370 IF V(I) >VH THEN VH = V(I)
380 NEXT
390 REM * SCALE PICTURE *
400 DU = 279/(UH -UL):DV = 191/(VH -VL): PRINT T$
410 D = DU: IF DV <D THEN D = DV
420 FOR I = U TO NP
430 U(I) = D *(U(I) -UL)
440 V(I) = D *(VH -V(I))
450 W(I) = D *W(I)
460 NEXT
470 REM * COMPUTE NORMAL VECTOR *
480 PRINT T$: FOR I = U TO NF
490 I1 = F%(I,U):I2 = I1 +N -U
500 P1 = FP%(I1):P2 = FP%(I1 +U):P3 = FP%(I1 +U +U)
510 D = (U(P3) -U(P2)) *(V(P2) -V(P1)) -(U(P2) -U(P1)) *(V(P3) -V(P2))
520 REM * TEST VISIBILITY OF FACE *
530 V%(I) = U: IF D > -EPS THEN V%(I) = Z: GOTO 670
540 EU(I,Z) = U(P1):EU(I,U) = U(P1)
550 EV(I,Z) = V(P1):EV(I,U) = V(P1)
560 EW(I,Z) = W(P1):EW(I,U) = W(P1)
570 REM * COMPUTE EXTENTS *
580 FOR K = I1 +U TO I2
590 J = FP%(K)
600 IF U(J) <EU(I,Z) THEN EU(I,Z) = U(J): GOTO 620
610 IF U(J) >EU(I,U) THEN EU(I,U) = U(J)
620 IF V(J) <EV(I,Z) THEN EV(I,Z) = V(J): GOTO 640
630 IF V(J) >EV(I,U) THEN EV(I,U) = V(J)
640 IF W(J) <EW(I,Z) THEN EW(I,Z) = W(J): GOTO 660
650 IF W(J) >EW(I,U) THEN EW(I,U) = W(J)
660 NEXT
670 NEXT
680 REM * INITIALLY ALL SEGMENTS ARE VISIBLE *
690 FOR I = U TO NE:E%(I,Z) = U: NEXT
700 REM * SET GRAPHICS MODE *
710 REM * FOR EACH SEGMENT #I *
720 HGR2 : HCOLOR= 3
730 FOR I = U TO NE
740 IF E%(I,Z) = Z THEN 1550
750 F1 = E%(I,3):F2 = E%(I,4)
760 IF F2 = Z THEN 790
770 REM * TEST FOR VISIBILITY *
780 IF V%(F1) = Z AND V%(F2) = Z THEN 1550
790 NS = 1:SL = Z:SH = U:S(U,Z) = SL:S(U,U) = SH
800 P1 = E%(I,U):P2 = E%(I,U +U):U1 = U(P1):V1 = V(P1):W1 = W(P1):U2 = U(P2):V2 = V(P2):W2 = W(P2):A1 = U2 -U1:A4 = V2 -V1
810 REM * FIND MAX. & MIN. IN EACH COORD. ON SEGMENT *
820 IF U1 <U2 THEN UL = U1:UH = U2: GOTO 840
830 UL = U2:UH = U1
840 IF V1 <V2 THEN VL = V1:VH = V2: GOTO 860
850 VL = V2:VH = V1
860 IF W1 <W2 THEN WL = W1:WH = W2: GOTO 890
870 WL = W2:WH = W1
880 REM * FOR EACH FACE #J *
890 FOR J = U TO NF
900 REM * AVOID INVISIBLE FACES *
910 IF V%(J) = Z THEN 1430
920 REM * AVOID BOUNDING FACES *
930 IF F1 = J OR F2 = J THEN 1430
940 REM * TEST AGAINST EXTENTS *
950 IF WH -EW(J,Z) <EPS THEN 1430
960 IF UH -EU(J,Z) <EPS THEN 1430
970 IF EU(J,U) -UL <EPS THEN 1430
980 IF VH -EV(J,Z) <EPS THEN 1430
990 IF EV(J,U) -VL <EPS THEN 1430
1000 REM * INTERSECTION TESTS MUST BE MADE *
1010 S1 = MX:S2 = MN:N = F%(J,Z):NN = F%(J,U):D1 = Z:D2 = Z
1020 FOR K = U TO N
1030 R1 = FP%(NN +K -U):R2 = FP%(NN +K)
1040 IF K = N THEN R2 = FP%(NN)
1050 A2 = U(R1) -U(R2):A3 = U(R1) -U1
1060 A5 = V(R1) -V(R2):A6 = V(R1) -V1
1070 DT = A1 *A5 -A2 *A4
1080 IF DT <EPS AND DT > -EPS THEN 1150
1090 S = (A3 *A5 -A2 *A6)/DT
1100 E = (A1 *A6 -A3 *A4)/DT
1110 IF E < -EPS OR E >U +EPS THEN 1150
1120 D = (W(R1) +(W(R2) -W(R1)) *E) -(W1 +(W2 -W1) *S)
1130 IF S <S1 THEN D1 = D:S1 = S
1140 IF S >S2 THEN D2 = D:S2 = S
1150 NEXT
1160 REM * IS FACE IN EDGE TO VIEWER? *
1170 IF ABS(S1 -S2) <EPS THEN 1430
1180 SJ = S1:DJ = D1: IF SJ <Z THEN SJ = Z:T = S1/(S1 -S2):DJ = D1 +T *(D2 -D1)
1190 SK = S2:DK = D2: IF SK >U THEN SK = U:T = (S1 -U)/(S1 -S2):DK = D1 +T *(D2 -D1)
1200 REM * IS THIS SEGMENT OBSCURED? *
1210 IF DJ > = -EPS AND DK > = -EPS THEN 1430
1220 IF SJ <SL +EPS AND SK >SH -EPS THEN E%(I,Z) = Z:J = NF: GOTO 1430
1230 REM * IS THERE AN INTERSECTION OF SEGMENT & FACE? *
1240 IF SK <EPS OR SJ >U -EPS THEN 1430
1250 REM * CHECK LISTS OF FRAGMENTS AGAINST SJ,SK *
1260 C = Z: FOR K = U TO NS
1270 S1 = S(K,Z):S2 = S(K,U)
1280 IF SJ <S1 +EPS THEN 1350
1290 IF SJ >S2 -EPS THEN 1340
1300 IF SK >S2 -EPS THEN 1330
1310 C = C +U:T(C,Z) = S1:T(C,U) = SJ
1320 C = C +U:T(C,Z) = SK:T(C,U) = S2: GOTO 1380
1330 C = C +U:T(C,Z) = S1:T(C,U) = SJ: GOTO 1380
1340 C = C +U:T(C,Z) = S1:T(C,U) = S2: GOTO 1380
1350 IF SK <S1 +EPS THEN 1340
1360 IF SK >S2 -EPS THEN 1380
1370 C = C +U:T(C,Z) = SK:T(C,U) = S2
1380 NEXT
1390 IF C = Z THEN J = NF:E%(I,Z) = Z: GOTO 1430
1400 NS = C:SL = T(U,Z):SH = T(C,U): FOR K = U TO NS
1410 S(K,Z) = T(K,Z):S(K,U) = T(K,U)
1420 NEXT
1430 NEXT
1440 REM * SKIP INVISIBLE SEGMENTS *
1450 IF E%(I,Z) = Z THEN 1550
1460 REM * FOR EACH VISIBLE SEGMENT HPLOT FRAGMENTS *
1470 FOR K = U TO NS
1480 S1 = S(K,Z):S2 = S(K,U):T1 = U -S1:T2 = U -S2
1490 LU = U1 *T1 +U2 *S1
1500 RU = U1 *T2 +U2 *S2
1510 LV = V1 *T1 +V2 *S1
1520 RV = V1 *T2 +V2 *S2
1530 HPLOT LU,LV TO RU,RV
1540 NEXT
1550 NEXT
1560 REM * ALLOW USER TO TYPE 'Y' FOR A NEW VIEW *
1570 PRINT CHR$(7): GET A$: IF A$ = "Y" THEN TEXT : GOTO 220
1580 PRINT : TEXT : END
1590 REM * SIMPLE ERROR ROUTINE *
1600 PRINT D$"CLOSE"F$
1610 PRINT "LINE NUMBER:"; PEEK(219) *256 + PEEK(218)
1620 PRINT "ERROR NUMBER:"; PEEK(222): TEXT